home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEM / OBJHANDL.D < prev    next >
Encoding:
Modula Definition  |  1990-10-09  |  21.9 KB  |  523 lines
  1. DEFINITION MODULE ObjHandler;
  2.  
  3.  
  4. (*      Megamax Modula-2 GEM-Library: ObjectHandler
  5.  *
  6.  *      geschrieben von Manuel Chakravarty
  7.  *
  8.  *      Version 2.1     V#0068      Created 30.06.1987
  9.  *)
  10.  
  11.  
  12.                     (*  Operationen auf Objektbäume  *)
  13.                     (*  ===========================  *)
  14.                         
  15.                         
  16.   (*  Die folgenden Routinen stellen ein Paket dar, das die Möglichkeit
  17.    *  bieten soll in eleganter Art und Weise auf die Objektbaumstrukturen
  18.    *  des GEM zuzugreifen. Die Sammlung wurde notwendig, da es die Struk-
  19.    *  tur des Baumes nicht erlaubt, ihn 'anständig' in Modula-Datentypen
  20.    *  zu fassen und andererseits Zugriffe über GEM-Funktionen nur unzu-
  21.    *  reichend möglich sind.
  22.    *  Die Routinen fangen Fehler, soweit es möglich ist ab und melden sie
  23.    *  bei Anfrage über 'ObjTreeError' an das aufrufende Modul. Allerdings
  24.    *  können Fehler, wie falsch übergebene Baumadressen und Zugriff auf un-
  25.    *  definierte Elemente in der Regel nicht erkannt werden.
  26.    *  Folgende Situationen lösen immer einen Fehler aus:
  27.    *
  28.    *     -- Zugriff auf ein Objekt während der momentane Baum mit 'NIL'
  29.    *        besetzt ist.
  30.    *     -- Zugriff auf ein Objekt, dessen Index größer als der des letzten
  31.    *        Objekts ist
  32.    *     -- Zugriff auf ein Objekt mit einer Prozedur, die mit dem Objekt-
  33.    *        typ nicht verträglich ist.
  34.    *
  35.    *  Die Operationen werden immer auf einen vorher festgelegten Baum ange-
  36.    *  wendet, dieser Baum wird im folgenden mit 'momentaner Baum' bezeich-
  37.    *  net. Die Ermittlung des momentanen Baumes geschieht mit Hilfe von
  38.    *  'CurrObjTree', mit einer entsprechenden Prozedur kann er auch gesetzt
  39.    *  werden.
  40.    *  Der erste Parameter der meisten Proceduren ist das Objekt, auf das die
  41.    *  Routine angewendet werden soll. Dieser Parameter heißt immer 'obj'
  42.    *  und ist vom Typ 'CARDINAL'.
  43.    *  Es bedeutet ein Wert von 'NIL', daß kein Baum vorhanden ist.
  44.    *  Die Objektbaumstruktur ist in 'GEMGlobals' definiert.
  45.    *)
  46.                         
  47.                         
  48. FROM SYSTEM     IMPORT WORD, LONGWORD;
  49.  
  50. FROM MOSGlobals IMPORT MemArea;
  51.  
  52. FROM GrafBase   IMPORT Point, Rectangle, PtrBitPattern;
  53.  
  54. FROM GEMGlobals IMPORT PtrObjTree, ObjType, OStateSet, OFlagSet, PtrObjSpec,
  55.                        THorJust, PtrMaxStr;
  56.  
  57.  
  58. PROCEDURE ObjTreeError (): BOOLEAN;
  59.  
  60.         (*  Es wird 'TRUE' geliefert, falls bei der LETZTEN Baumoperation
  61.          *  ein Fehler auftratt (zum Beispiel Aufruf während der momen-
  62.          *  tane Baum 'NIL' ist).
  63.          *)
  64.  
  65. PROCEDURE CreateObjTree (    noElements: CARDINAL;
  66.                              sys       : BOOLEAN;
  67.                          VAR success   : BOOLEAN);
  68.  
  69.         (*  Erzeugt einen Objektbaum, der 'noElements' Elemente enthält.
  70.          *  Der erzeugte Baum ist danach der momentane Baum und alle Ele-
  71.          *  mente des Baumes befinden sich in einem undefinierten Zustand.
  72.          *  Ist nicht genug Speicher vorhanden, so ist 'success = FALSE'.
  73.          *
  74.          *  Ist 'sys = TRUE', so wird ein Systembaum erzeugt, das heißt
  75.          *  alle Speicheranforderungen laufen über 'Storage.SysAlloc'.
  76.          *)
  77.          
  78. PROCEDURE DeleteObjTree;
  79.  
  80.         (*  Gibt den Speicher des mom. Baumes und all seiner Objektspezi-
  81.          *  fikationen frei. Spezifikationen die 'NIL' sind werden ignoriert.
  82.          *)
  83.  
  84. PROCEDURE SetCurrObjTree (tree: PtrObjTree; sys: BOOLEAN);
  85.  
  86.         (*  Danach ist 'tree' der momentane Baum. Ist 'sys = TRUE', so
  87.          *  wird angenommen, das ein Systembaum übergeben wurde (Siehe
  88.          *  'CreateObjTree').
  89.          *  Das letzte Objekt (das mit dem höchsten Index) muß das Objekt-
  90.          *  flag 'lastObjFlg' besitzen!
  91.          *)
  92.          
  93. PROCEDURE CurrObjTree (): PtrObjTree;
  94.  
  95.         (*  Liefert einen Zeiger auf den momentanen Baum.
  96.          *)
  97.         
  98. PROCEDURE LastObject (): CARDINAL;
  99.  
  100.         (*  Liefert den Index des letzten Baumelements, d.h das welches den
  101.          *  höchsten Index besitzt.
  102.          *)
  103.          
  104. PROCEDURE SetObjType (obj: CARDINAL; type: ObjType);
  105.  
  106.         (*  Legt Objekttyp des Objektes 'obj' fest.
  107.          *)
  108.         
  109. PROCEDURE ObjectType (obj: CARDINAL): ObjType;
  110.  
  111.         (*  Liefert Objekttyp des Objektes 'obj'.
  112.          *)
  113.          
  114. PROCEDURE SetObjFlags (obj: CARDINAL; flags: OFlagSet);
  115.  
  116.         (*  Setzt die Flags des Objektes 'obj' auf 'flags'.
  117.          *)
  118.         
  119. PROCEDURE ObjectFlags (obj: CARDINAL): OFlagSet;
  120.  
  121.         (*  Liefert die Flags des Objektes 'obj'.
  122.          *)
  123.         
  124. PROCEDURE SetObjState (obj: CARDINAL; state: OStateSet);
  125.  
  126.         (*  Setzt den Objektstatus auf 'state'.
  127.          *)
  128.         
  129. PROCEDURE ObjectState (obj: CARDINAL): OStateSet;
  130.  
  131.         (*  Liefert den Objektstatus des Objektes 'obj'.
  132.          *)
  133.         
  134. PROCEDURE SetObjSpace (obj: CARDINAL; space: Rectangle);
  135.  
  136.         (*  Legt den Bereich den das Objekt ausfüllt fest.
  137.          *)
  138.         
  139. PROCEDURE ObjectSpace (obj: CARDINAL): Rectangle;
  140.  
  141.         (*  Ermittelt den vom momentanen Objekt belegten Bildschirmbereich.
  142.          *)
  143.         
  144. PROCEDURE SetObjRelatives (obj: CARDINAL; next, head, tail: CARDINAL);
  145.  
  146.         (*  Legt die 3 Zeiger auf verwandte Objekte fest. 'next' zeigt auf
  147.          *  den nächsten Bruder (oder falls keiner vorhanden ist auf den
  148.          *  Vorgänger), 'head' zeigt auf den ersten Nachfolger und 'tail'
  149.          *  auf den Letzte. 'NoObject' zeigt dabei jeweils an, daß das ent-
  150.          *  sprechende Objekt nicht existiert (z.B. 'next = NoObject' bedeu-
  151.          *  tet, es existiert weder Bruder noch Vorgänger, das Objekt ist al-
  152.          *  so die Baumwurzel).
  153.          *)
  154.          
  155. PROCEDURE GetObjRelatives (obj: CARDINAL; VAR next, head, tail: CARDINAL);
  156.  
  157.         (*  Liest die von 'SetObjRelatives' gesetzten Werte.
  158.          *)
  159.         
  160. PROCEDURE Parent (obj: CARDINAL): CARDINAL;
  161.  
  162.         (*  Es wird der Vorgänger des Objektes 'obj' zurückgegeben.
  163.          *  Ein Fehler tritt auf, falls 'obj' die Wurzel des Baumes ist.
  164.          *)
  165.          
  166. PROCEDURE LeftSister (obj: CARDINAL): CARDINAL;
  167.  
  168.         (*  Es wird der linke Nachbar des Objektes 'obj' ermittelt.
  169.          *  Ist 'obj' das erste Element der Nachfolgerliste des Vorgängers,
  170.          *  so tritt ein Fehler auf.
  171.          *)
  172.          
  173. PROCEDURE RightSister (obj: CARDINAL): CARDINAL;
  174.  
  175.         (*  Es wird der rechte Nachbar ermittelt.
  176.          *  Ist 'obj' das letzte Element der Nachfolgerliste, so tritt ein
  177.          *  Fehler auf.
  178.          *)
  179.          
  180. PROCEDURE CreateSpecification (obj: CARDINAL; spec: PtrObjSpec);
  181.  
  182.         (*  Die Objektspezifikation des Objekts 'obj' wird erzeugt.
  183.          *  Die Routine arbeitet in zwei Modi:
  184.          *
  185.          *  'spec=NIL' -- Falls die Objektspezifikation des Objekts ein
  186.          *                Zeiger auf eine Struktur ist, z.B. 'TEdInfo',
  187.          *                so wird diese Struktur alloziert und ihre Adres-
  188.          *                se eingetragen, sonst wird die Objektspezifika-
  189.          *                tion einfach gelöscht.
  190.          *                Ist das 'indirectFlg'-Flag des Objekts gesetzt,
  191.          *                so wird zuerst eine neue Spezifikation alloziert
  192.          *                und dann wie oben verfahren.
  193.          *  'spec#NIL' -- Es wird 'spec^' als zu setzende Spezifikation be-
  194.          *                trachted und somit in das Objekt eingetragen. Ist
  195.          *                das 'indirectFlg'-Flag gesetzt, so wird 'spec',
  196.          *                eingtragen ('spec' ist ein Zeiger auf eine Spezi-
  197.          *                fikation).
  198.          *                Hinweis: Die Routine ist während der Laufzeit
  199.          *                         nicht in der Lage zu überprüfen, ob die
  200.          *                         gesetzte Objektspezifikation mit dem
  201.          *                         Objekttyp verträglich ist.
  202.          *
  203.          *  Achtung: Zum Zeitpunkt des Aufrufs dieser Routine muß der Typ
  204.          *           des Objekts 'obj' und der Wert des 'indirectFlg', aus
  205.          *           den Objektflags, schon gesetzt sein.
  206.          *)
  207.  
  208. PROCEDURE SetBoxChar (obj: CARDINAL; ch: CHAR);
  209.  
  210.         (*  Es wird das Zeichen eines 'boxCharObj'-Objekts mit 'ch' besetzt.
  211.          *)
  212.          
  213. PROCEDURE BoxChar (obj: CARDINAL): CHAR;
  214.  
  215.         (*  Das Zeichen des 'boxCharObj'-Objekts wird ermittelt.
  216.          *)
  217.         
  218.         
  219. TYPE    SignedByte      = [-127..128];
  220.  
  221.         (* Hier ist uns leider ein Fehler passiert: Es müßte [-128..127]
  222.          * heißen. Um einen Versionskonflikt zu vermeiden, belassen wir's
  223.          * bei diesem Fehler, denn in der Praxis hat dies wohl keine
  224.          * Auswirkungen. *)
  225.  
  226. PROCEDURE SetBorderThickness (obj: CARDINAL; thick: SignedByte);
  227.  
  228.         (*  Die Randstärke des Objektes wird auf 'thick' gesetzt.
  229.          *)
  230.          
  231. PROCEDURE BorderThickness (obj: CARDINAL): SignedByte;
  232.  
  233.         (*  Die Randstärke eines Objekts wird ermittelt.
  234.          *)
  235.         
  236. PROCEDURE SetComplexColor (obj        : CARDINAL;
  237.                            borderCol,
  238.                            textCol,
  239.                            fillCol,
  240.                            fillDensity: CARDINAL;
  241.                            opaque     : BOOLEAN);
  242.                            
  243.         (*  Mit dieser Routine wird die Farbgebung aller Objekttypen, aus-
  244.          *  genommen 'imageObj', 'iconObj', 'progDefObj', 'stringObj' und
  245.          *  'titleObj', 'buttonObj', festgelegt.
  246.          *  Dabei ist 'borderCol' die Farbe des Randes, 'textCol' die, in
  247.          *  der Text erscheinen soll und 'fillCol' die Füllfarbe.
  248.          *  'fillDensity' gibt die Intensität des Füllmusters an, dabei be-
  249.          *  deutet 0 keine Füllung und 7 vollständige Füllung. Mit 1 bis 6
  250.          *  erzeugt man ein immer dichter werdendes Punktmuster.
  251.          *  'opaque' gibt den Schreibmodus des Textes an, dabei es steht
  252.          *  'TRUE' für überdeckend und 'FALSE' für transparent.
  253.          *)
  254.          
  255. PROCEDURE GetComplexColor (    obj        : CARDINAL;
  256.                            VAR borderCol,
  257.                                textCol,
  258.                                fillCol,
  259.                                fillDensity: CARDINAL;
  260.                            VAR opaque     : BOOLEAN);
  261.                           
  262.         (*  Erfragt die mit 'SetComplexColor' gesetzten Werte.
  263.          *)
  264.         
  265. PROCEDURE SetIconColor (obj: CARDINAL; foreGround, backGround: CARDINAL);
  266.  
  267.         (*  Setzt die Vordergrund 'foreGround' und Hintergrund 'backGround'
  268.          *  Farben von Objekten des Typs 'iconObj'.
  269.          *)
  270.          
  271. PROCEDURE GetIconColor (obj: CARDINAL; VAR foreGround, backGround: CARDINAL);
  272.  
  273.         (*  Ermittelt die mit 'SetIconColor' gesetzten Farben.
  274.          *)
  275.         
  276. PROCEDURE SetImageColor (obj: CARDINAL; color: CARDINAL);
  277.  
  278.         (*  Legt die Farbe fest, in der die gesetzten Punkte des Bitmusters
  279.          *  eines 'imageObj'-Objekts dargestellt werden sollen.
  280.          *)
  281.          
  282. PROCEDURE GetImageColor (obj: CARDINAL; VAR color: CARDINAL);
  283.  
  284.         (*  Liefert die mit 'SetImageColor' festgelegte Farbe.
  285.          *)
  286.         
  287. PROCEDURE SetTextForm (obj: CARDINAL; font: CARDINAL; just: THorJust);
  288.  
  289.         (*  Legt den Zeichensatz 'font' und die Textausrichtung 'just' des
  290.          *  Objektes 'obj' fest, welches als Spezifikation eine 'TEdInfo'-
  291.          *  Struktur besitzen muß.
  292.          *  Als Zeichensatz kann man 'SmallFont' oder 'StandardFont' wählen.
  293.          *  Wird aus 'GEMGlobals' importiert.
  294.          *)
  295.          
  296. PROCEDURE GetTextForm (obj: CARDINAL; VAR font: CARDINAL; VAR just: THorJust);
  297.  
  298.         (*  Liefert die mit 'SetTextForm' gesetzten Parameter.
  299.          *)
  300.         
  301. PROCEDURE SetIconForm (obj      : CARDINAL;
  302.                        charPos  : Point;
  303.                        iconFrame,
  304.                        textFrame: Rectangle);
  305.                        
  306.         (*  Hiermit bestimmt man bei Objekten vom Typ 'iconObj' die Position
  307.          *  des Zeichens mit 'charPos', den Rahmen in dem das Piktogramm
  308.          *  liegt mit 'iconFrame' und das Rechteck, das den Text umschließt,
  309.          *  mit 'textFrame'.
  310.          *  Alle Angaben werden in Pixeln gemacht und sind relativ zu dem
  311.          *  Rahmen des Gesamtobjekts.
  312.          *)
  313.          
  314. PROCEDURE GetIconForm (    obj      : CARDINAL;
  315.                        VAR charPos  : Point;
  316.                        VAR iconFrame,
  317.                            textFrame: Rectangle);
  318.                        
  319.         (*  Ermittelt die mit 'SetIconForm' festgelegten Werte.
  320.          *)
  321.         
  322. PROCEDURE SetImageForm (obj      : CARDINAL;
  323.                         byteWidth,
  324.                         height,
  325.                         deltaX,
  326.                         deltaY   : INTEGER);
  327.  
  328.         (*  Für Objekte vom Typ 'imageObj gibt 'byteWidth' die Breite des
  329.          *  Bitmusters in Bytes an und muß eine gerade Zahl sein. 'height'
  330.          *  ist die Höhe des Bitmusters in Pixeln und 'deltaX' bzw. 'deltaY'
  331.          *  geben je einen Offset an, der festlegt wieviel Pixel, vom linken
  332.          *  bzw. oberen Rand des Bitmusters entfernt mit dem Darstellen des-
  333.          *  selbigen begonnen werden soll.
  334.          *)
  335.          
  336. PROCEDURE GetImageForm (    obj      :CARDINAL;
  337.                         VAR byteWidth,
  338.                             height,
  339.                             deltaX,
  340.                             deltaY   :INTEGER);
  341.                         
  342.         (*  Erfragt die mit 'SetImageForm' festgelegten Werte.
  343.          *)
  344.         
  345. TYPE    SetPtrChoice    = (create, setOnly, reCreate, noChange);
  346.  
  347.          (*  Beim Setzen von Pointervariblen kann man mit einem Parameter
  348.           *  des obigen Typs wählen, ob die Variable neu alloziert werden
  349.           *  oder ob sie nur einen neuen Wert erhalten soll.
  350.           *
  351.           *  'create'   -- Variable neu allozieren
  352.           *  'setOnly'  -- Nur Wert zuweisen
  353.           *  'reCreate' -- Alte Variable deallozieren und dann
  354.           *                wie bei 'create' verfahren
  355.           *  'noChange' -- Die Variable wird nicht beeinflußt
  356.           *)
  357.  
  358. PROCEDURE AssignTextStrings
  359.                        ( obj: CARDINAL;
  360.                          textChoice : SetPtrChoice; REF textS: ARRAY OF CHAR;
  361.                          tmpltChoice: SetPtrChoice; REF tmplt: ARRAY OF CHAR;
  362.                          validChoice: SetPtrChoice; REF valid: ARRAY OF CHAR );
  363.  
  364.         (*  Hiermit werden die Strings einer 'TEdInfo'-Struktur gesetzt, dabei
  365.          *  kann mit Hilfe der '...Choice'-Parameter gewählt werden, ob der
  366.          *  String neu allociert werden oder nur mit einem Wert besetzt werden
  367.          *  soll (Siehe oben).
  368.          *  Es wird 'textS' der Zeichenkette zugewiesen, die den Text enthält;
  369.          *  'tmplt' ist für die Maske und 'valid' für den String, der die
  370.          *  erlaubten Zeichen enthält.
  371.          *  'TEdInfo.tmpltLen' bekommt die Länge von 'tmplt' zugewiesen und
  372.          *  'TedInfo.textLen' die von 'valid'.
  373.          *  Außerdem kann mit dieser Routine die Zeichenkette von Objekten
  374.          *  des Typ 'buttonObj', 'stringObj' oder 'titleObj' gesetzt werden,
  375.          *  dazu müssen aber 'tmpltChoice' und 'validChoice' den Wert
  376.          *  'noChange' enthalten, sonst wird ein Fehler ausgelöst (Siehe
  377.          *  'ObjTreeError').
  378.          *)
  379.          
  380. PROCEDURE LinkTextString (obj: CARDINAL; str: PtrMaxStr);
  381.  
  382.         (*  Diese Routine weißt der Textzeichenkette eines 'TEdInfo'-RECORDs
  383.          *  nicht einfach einen Wert zu, sondern es wird die Adresse des
  384.          *  angegebene Strings 'str' eingetragen.
  385.          *  Ist das so veränderte Objekt edierbar, so werden alle Änderungen
  386.          *  direkt in dieser Zeichenkette vorgenommen.
  387.          *)
  388.  
  389. PROCEDURE GetTextStrings (    obj  : CARDINAL;
  390.                           VAR textS,
  391.                               tmplt,
  392.                               valid: ARRAY OF CHAR);
  393.  
  394.         (*  Liefert die mit 'AssignTextStrings' gesetzten Strings zurück.
  395.          *)
  396.         
  397. PROCEDURE SetStringLength (obj: CARDINAL; textLen, tmpltLen: CARDINAL);
  398.  
  399.         (*  Erlaubt es 'TedInfo.textLen/tmpltLen' zu setzen.
  400.          *)
  401.         
  402. PROCEDURE GetStringLength (obj: CARDINAL; VAR textLen, tmpltLen: CARDINAL);
  403.  
  404.         (*  Erfragt die von 'SetStringLength' gesetzten Werte.
  405.          *)
  406.         
  407. PROCEDURE SetImagePattern (obj: CARDINAL; pattern: PtrBitPattern);
  408.  
  409.         (*  Legt das Bitmuster des Objekts 'obj', welches vom typ 'imageObj'
  410.          *  sein muß fest.
  411.          *)
  412.          
  413. PROCEDURE GetImagePattern (obj: CARDINAL; VAR pattern: PtrBitPattern);
  414.  
  415.         (*  Liefert einen Zeiger auf das Bitmuster von 'obj'.
  416.         *)
  417.         
  418. PROCEDURE SetIconLook (    obj   : CARDINAL;
  419.                            data,
  420.                            mask  : PtrBitPattern;
  421.                            choice: SetPtrChoice;
  422.                        REF str   : ARRAY OF CHAR;
  423.                            ch    : CHAR);
  424.  
  425.         (*  Einem Objekt vom Typ 'iconObj' wird der Zeiger auf das Daten-
  426.          *  bitmuster ('data') und die Maske ('mask') zugewiesen. Außerdem
  427.          *  wird die Bildunterschrift des Icons mit 'str' besetzt. Dabei
  428.          *  bestimmt 'choice' auf welche Art die Zeichenkette eingetragen
  429.          *  wird (Siehe 'SetPtrChoice'). Schlußendlich wird 'ch' zu dem
  430.          *  im Piktogramm erscheienden Zeichen.
  431.          *)
  432.                       
  433. PROCEDURE GetIconLook (    obj :CARDINAL;
  434.                        VAR data,
  435.                            mask:PtrBitPattern;
  436.                        VAR str :ARRAY OF CHAR;
  437.                        VAR ch  :CHAR);
  438.                       
  439.         (*  Erfragt die von 'SetIconLook' gesetzten Parameter.
  440.          *)
  441.          
  442.          
  443. (*      Die folgenden Routinen sind für eine ganz besondere Sorte von
  444.  *      Objekten gedacht, für die vom Programmierer selbstdefinierten
  445.  *      Objekte ("user defined objects").
  446.  *      Wann immer ein solches Objekt auf dem Bildschirm dargestellt wird oder
  447.  *      dessen Objektstatus verändert werden soll, wird eine selbstdefinier-
  448.  *      bare Routine aufgerufen. Diese kann, mit Hilfe der VDI-Funktionen,
  449.  *      die Gestaltung des Objektes in eigener Regie übernehmen. Dazu werden
  450.  *      der Prozedur, die vom Typ 'ProgDefProc' sein muß, der Baum 'tree'
  451.  *      und der Objektindex ('index') des darzustellenden Objekts überge-
  452.  *      ben. Außerdem werden ihr, falls nur der Objektstatus geändert werden
  453.  *      soll, der alte ('prevState') und der neue Status ('curState') übergeben.
  454.  *      Sind die beiden gleich, so heißt dies, daß das Objekt komplett neu
  455.  *      gezeichnet werden muß. 'space' gibt die Größe des Objekts an und
  456.  *      'clip' sagt, welcher Bereich beim Zeichnen nicht verlassen werden darf.
  457.  *      Letztlich wird in 'parm' ein Langwort geliefert, das beim Baumaufbau
  458.  *      angegeben werden muß und dessen Verwendung dem Programmierer überlas-
  459.  *      sen ist. Als Rückgabewert muß die selbstdefinierte Routine die Zustände
  460.  *      liefern, die noch vom AES gesetzt werden sollen (Es wird dann die
  461.  *      normale Vorgehensweise gewählt, wird zum Beispiel 'selectFlg' gelie-
  462.  *      fert, so wird die Zeichnung invertiert).
  463.  *
  464.  *      Hinweis: Da das AES nicht reentrant-fähig ist, sollte auf AES-Aufrufe
  465.  *               in einer solchen Objektbaumprozedur verzichtet werden.
  466.  *
  467.  *      Eine Demo-Anwendung hierfür findet sich im DEMO-Ordner (PROGDEFD.M).
  468.  *)
  469.         
  470.         
  471. TYPE    ProgDefProc     = PROCEDURE((* tree     : *) PtrObjTree,
  472.                                     (* index    : *) CARDINAL,
  473.                                     (* prevState: *) OStateSet,
  474.                                     (* curState : *) OStateSet,
  475.                                     (* space    : *) Rectangle,
  476.                                     (* clip     : *) Rectangle,
  477.                                     (* parm     : *) LONGWORD  ): OStateSet;
  478.                                     
  479.         ProgDefCarrier  = ARRAY[0..15] OF WORD;
  480.  
  481.  
  482. PROCEDURE MakeProgDefProc (VAR hdl : ProgDefCarrier;
  483.                                proc: ProgDefProc;
  484.                                wsp : MemArea       );
  485.                            
  486.         (*  Macht die Prozedur 'proc' zu einer Routine, die in einer Objekt-
  487.          *  baumstruktur angegeben werden kann. Dieser Vorgang muß nicht
  488.          *  rückgänig gemacht werden (auch nicht bei der Programmterminierung)
  489.          *  und beeinflußt die Funktionweise von 'proc' in keiner Weise.
  490.          *  Es ist 'hdl' nach dem Aufruf Kennung für die Prozedur und Spei-
  491.          *  cherbereich für systeminterne Daten. 'hdl' muß global definiert
  492.          *  sein und darf weder anderweitig benutzt, noch irgendwie freige-
  493.          *  geben werden. Erst wenn kein Objektbaum mehr existiert, der 'proc'
  494.          *  enthält und auch kein solcher mehr erstellt werden soll, ist 'hdl'
  495.          *  wieder frei.
  496.          *  Das Gleiche gilt für den in 'wsp' beschriebenen Speicherbereich,
  497.          *  der von 'proc' als Stack benutzt wird.
  498.          *  Eine Demo hierfür findet sich im DEMO-Ordner (PROGDEFD.M).
  499.          *)
  500.                            
  501. PROCEDURE SetProgDefSpec (    obj : CARDINAL;
  502.                           VAR hdl : ProgDefCarrier;
  503.                               parm: LONGWORD);
  504.  
  505.         (*  Das Objekt 'obj', welches vom Typ 'progDefObj' sein muß, bekommt
  506.          *  die durch 'hdl' beschriebene Prozedur und den Parameter 'parm'
  507.          *  zugewiesen.
  508.          *  Zu 'hdl' siehe 'MakeProgDefProc'.
  509.          *  Eine Demo hierfür findet sich im DEMO-Ordner (PROGDEFD.M).
  510.          *)
  511.  
  512. PROCEDURE GetProgDefSpec (    obj : CARDINAL;
  513.                           VAR proc: ProgDefProc;
  514.                           VAR parm: LONGWORD);
  515.         
  516.         (*  Erfragt die mit 'SetProgDefSpec' gesetzten Werte, dabei wird al-
  517.          *  lerdings statt des 'ProgDefCarrier's die Procedure 'proc' über-
  518.          *  geben, mit welcher der 'ProgDefCarrier' initialisiert wurde.
  519.          *)
  520.  
  521.  
  522. END ObjHandler.
  523.